home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / share / mc / extfs / debd < prev    next >
Text File  |  2009-10-25  |  10KB  |  363 lines
  1. #! /usr/bin/perl
  2. #
  3. # 1999 (c) Piotr Roszatycki <dexter@debian.org>
  4. # This software is under GNU license
  5. # last modification: 1999-12-08
  6. #
  7. # debd
  8.  
  9. sub quote {
  10.     $_ = shift(@_);
  11.     s/([^\w\/.+-])/\\$1/g;
  12.     return($_);
  13. }
  14.  
  15. sub bt
  16. {
  17.     my ($dt) = @_;
  18.     my (@time);
  19.     @time = localtime($dt);
  20.     $bt = sprintf "%02d-%02d-%d %02d:%02d", $time[4] + 1, $time[3],
  21.           $time[5] + 1900, $time[2], $time[1];
  22.     return $bt;
  23. }
  24.  
  25.  
  26. sub ft
  27. {
  28.     my ($f) = @_;
  29.     return "d" if -d $f;
  30.     return "l" if -l $f;
  31.     return "p" if -p $f;
  32.     return "S" if -S $f;
  33.     return "b" if -b $f;
  34.     return "c" if -c $f;
  35.     return "-";
  36. }
  37.  
  38. sub fm
  39. {
  40.     my ($n) = @_;
  41.     my ($m);
  42.  
  43.     if( $n & 0400 ) {
  44.        $m .= "r";
  45.     } else {
  46.        $m .= "-";
  47.     }
  48.     if( $n & 0200 ) {
  49.        $m .= "w";
  50.     } else {
  51.        $m .= "-";
  52.     }
  53.     if( $n & 04000 ) {
  54.        $m .= "s";
  55.     } elsif( $n & 0100 ) {
  56.        $m .= "x";
  57.     } else {
  58.        $m .= "-";
  59.     }
  60.  
  61.     if( $n & 0040 ) {
  62.        $m .= "r";
  63.     } else {
  64.        $m .= "-";
  65.     }
  66.     if( $n & 0020 ) {
  67.        $m .= "w";
  68.     } else {
  69.        $m .= "-";
  70.     }
  71.     if( $n & 02000 ) {
  72.        $m .= "s";
  73.     } elsif( $n & 0010 ) {
  74.        $m .= "x";
  75.     } else {
  76.        $m .= "-";
  77.     }
  78.  
  79.     if( $n & 0004 ) {
  80.        $m .= "r";
  81.     } else {
  82.        $m .= "-";
  83.     }
  84.     if( $n & 0002 ) {
  85.        $m .= "w";
  86.     } else {
  87.        $m .= "-";
  88.     }
  89.     if( $n & 01000 ) {
  90.        $m .= "t";
  91.     } elsif( $n & 0001 ) {
  92.        $m .= "x";
  93.     } else {
  94.        $m .= "-";
  95.     }
  96.  
  97.     return $m;
  98. }
  99.  
  100. sub ls {
  101.     my ($file) = @_;
  102.     my @stat = stat($file);
  103.     # mode, nlink, uid, gid, size, mtime, filename
  104.     printf "%s%s %d %d %d %d %s CONTENTS%s\n", ft($file), fm($stat[2] & 07777),
  105.     $stat[3], $stat[4], $stat[5], $stat[7], bt($stat[9]), $file;
  106. }
  107.  
  108. sub list
  109. {
  110.        my($archive)=@_;
  111.        my $qarchive = quote($archive);
  112.        chop($date=`LC_ALL=C date "+%b %d %Y %H:%M"`);
  113.        chop($info_size=`dpkg -s $qarchive | wc -c`);
  114.        $repack_size=length($pressrepack);
  115.        $reinstall_size=length($pressreinstall);
  116.        $remove_size=length($pressremove);
  117.        $purge_size=length($presspurge);
  118.        $reconfigure_size=length($pressreconfigure);
  119.        $reinstall_size=length($pressreinstall);
  120.        $select_size=length($pressselect);
  121.        $unselect_size=length($pressunselect);
  122.  
  123.        print "dr-xr-xr-x   1 root     root     0 $date CONTENTS\n";
  124.        print "dr-xr-xr-x   1 root     root     0 $date DEBIAN\n";
  125.        print "-r--r--r--   1 root     root     $info_size $date INFO\n";
  126.        print "-r-xr--r--   1 root     root     $purge_size $date DPKG-PURGE\n";
  127.  
  128.        chop($status = `dpkg -s $qarchive | grep ^Status`);
  129.        if( $status =~ /deinstall/ ) {
  130.            print "-r-xr--r--   1 root     root     $select_size $date DPKG-SELECT\n";
  131.        } elsif( $status =~ /install/ ) {
  132.            print "-r-xr--r--   1 root     root     $unselect_size $date DPKG-UNSELECT\n";
  133.        } 
  134.        if( $status !~ /config-files/ ) {
  135.            if ( -x "/usr/bin/dpkg-repack" ) {
  136.                print "-r-xr--r--   1 root     root     $repack_size $date DPKG-REPACK\n";
  137.            }
  138.            print "-r-xr--r--   1 root     root     $remove_size $date DPKG-REMOVE\n";
  139.            if ( -x "/usr/bin/apt-get" ) {
  140.                print "-r-xr--r--   1 root     root     $remove_size $date APT-REMOVE\n";
  141.                print "-r-xr--r--   1 root     root     $reinstall_size $date APT-REINSTALL\n";
  142.                print "-r-xr--r--   1 root     root     $purge_size $date APT-PURGE\n";
  143.        }
  144.        }
  145.        if( -x "/usr/bin/dpkg-reconfigure" && -x "/var/lib/dpkg/info/$archive.config" ) {
  146.            print "-r-xr--r--   1 root     root     $reconfigure_size $date DPKG-RECONFIGURE\n";
  147.        }
  148.  
  149.  
  150.  
  151.        if ( open(PIPEIN, "LANG=C ls -l /var/lib/dpkg/info/$qarchive.* |") ) {
  152.            while(<PIPEIN>) {
  153.                chop;
  154.                next if /\.list$/;
  155.                s%/var/lib/dpkg/info/$archive.%DEBIAN/%;
  156.                print $_, "\n";
  157.            }
  158.            close PIPEIN;
  159.        }
  160.  
  161.         if ( open(LIST, "/var/lib/dpkg/info/$archive.list") ) {
  162.             while(<LIST>) {
  163.                chop;
  164.                ls($_);
  165.             }
  166.            close LIST;
  167.         }
  168. }
  169.  
  170. sub copyout
  171. {
  172.        my($archive,$filename,$destfile)=@_;
  173.        my $qarchive = quote($archive);
  174.        my $qfilename = quote($filename);
  175.        my $qdestfile = quote($destfile);
  176.  
  177.        if($filename eq "INFO") {
  178.            system("dpkg -s $qarchive > $qdestfile");
  179.         } elsif($filename eq "DPKG-REPACK") {
  180.            if ( open(FILEOUT,">$destfile") ) {
  181.                print FILEOUT $pressrepack;
  182.                close FILEOUT;
  183.                system("chmod a+x $qdestfile");
  184.            }
  185.         } elsif($filename =~ /^DEBIAN/) {
  186.             $filename=~s!^DEBIAN/!!;
  187.             system("cat /var/lib/dpkg/info/$qarchive.$qfilename > $qdestfile");
  188.        } elsif($filename eq "DPKG-REMOVE" || $filename eq "APT-REMOVE") {
  189.            if ( open(FILEOUT,">$destfile") ) {
  190.                print FILEOUT $pressremove;
  191.                close FILEOUT;
  192.                system("chmod a+x $qdestfile");
  193.            }
  194.        } elsif($filename eq "DPKG-PURGE" || $filename eq "APT-PURGE") {
  195.            if ( open(FILEOUT,">$destfile") ) {
  196.                print FILEOUT $presspurge;
  197.                close FILEOUT;
  198.                system("chmod a+x $qdestfile");
  199.            }
  200.        } elsif($filename eq "DPKG-RECONFIGURE") {
  201.            if ( open(FILEOUT,">$destfile") ) {
  202.                print FILEOUT $pressreconfigure;
  203.                close FILEOUT;
  204.                system("chmod a+x $qdestfile");
  205.            }
  206.        } elsif($filename eq "APT-REINSTALL") {
  207.            if ( open(FILEOUT,">$destfile") ) {
  208.                print FILEOUT $pressreinstall;
  209.                close FILEOUT;
  210.                system("chmod a+x $destfile");
  211.            }
  212.        } elsif($filename eq "DPKG-SELECT") {
  213.            if ( open(FILEOUT,">$destfile") ) {
  214.                print FILEOUT $pressselect;
  215.                close FILEOUT;
  216.                system("chmod a+x $destfile");
  217.            }
  218.        } elsif($filename eq "DPKG-UNSELECT") {
  219.            if ( open(FILEOUT,">$destfile") ) {
  220.                print FILEOUT $pressunselect;
  221.                close FILEOUT;
  222.                system("chmod a+x $qdestfile");
  223.            }
  224.        } else {
  225.            $qfilename=~s!^CONTENTS!!;
  226.            system("cat $qfilename > $qdestfile");
  227.        }
  228. }
  229.  
  230. sub run
  231. {
  232.        my($archive,$filename)=@_;
  233.        my $qarchive = quote($archive);
  234.        my $qfilename = quote($filename);
  235.        if($filename eq "DPKG-REMOVE") {
  236.            system("dpkg --remove $qarchive");
  237.        } elsif($filename eq "APT-REMOVE") {
  238.            system("apt-get remove $qarchive");
  239.        } elsif($filename eq "DPKG-PURGE") {
  240.            system("dpkg --purge $qarchive");
  241.        } elsif($filename eq "APT-PURGE") {
  242.            system("apt-get --purge remove $qarchive");
  243.        } elsif($filename eq "DPKG-REPACK") {
  244.            system("dpkg-repack $qarchive");
  245.        } elsif($filename eq "DPKG-SELECT") {
  246.            system("echo $aqrchive install | dpkg --set-selections");
  247.        } elsif($filename eq "DPKG-UNSELECT") {
  248.            system("echo $qarchive deinstall | dpkg --set-selections");
  249.        } elsif($filename eq "APT-REINSTALL") {
  250.            system("apt-get -u --reinstall install $qarchive");
  251.        } elsif($filename eq "DPKG-RECONFIGURE") {
  252.            system("dpkg-reconfigure $qarchive");
  253.        } elsif($filename=~/^DEBIAN/) {
  254.            $filename=~s!^DEBIAN!!;
  255.            system("/var/lib/dpkg/info/$qarchive.$qfilename");
  256.        } else {
  257.            $qfilename=~s!^CONTENTS!!;
  258.            system($qfilename);
  259.        }
  260. }
  261.  
  262. $pressrepack=<<EOInstall;
  263.  
  264.                                 WARNING
  265.   Don\'t use this method if you are not willing to repack this package...
  266.  
  267. This is not a real file. It is a way to repack the package you are browsing.
  268.  
  269. To repack this package go back to the panel and press Enter on this file.
  270.  
  271. EOInstall
  272.  
  273. $pressreinstall=<<EOInstall;
  274.  
  275.                                 WARNING
  276.   Don\'t use this method if you are not willing to reinstall this package...
  277.  
  278. This is not a real file. It is a way to reinstall the package you are browsing.
  279.  
  280. To reinstall this package go back to the panel and press Enter on this file.
  281.  
  282. EOInstall
  283.  
  284. $pressremove=<<EOInstall;
  285.  
  286.                                 WARNING
  287.   Don\'t use this method if you are not willing to remove this package...
  288.  
  289. This is not a real file. It is a way to remove the package you are browsing.
  290.  
  291. To remove this package go back to the panel and press Enter on this file.
  292.  
  293. EOInstall
  294.  
  295. $presspurge=<<EOInstall;
  296.  
  297.                                 WARNING
  298.   Don\'t use this method if you are not willing to purge this package...
  299.  
  300. This is not a real file. It is a way to purge the package you are browsing.
  301.  
  302. To purge this package go back to the panel and press Enter on this file.
  303.  
  304. EOInstall
  305.  
  306. $pressreconfigure=<<EOInstall;
  307.  
  308.                                 WARNING
  309.   Don\'t use this method if you are not willing to reconfigure this package...
  310.  
  311. This is not a real file. It is a way to reconfigure the package you are browsing.
  312.  
  313. To reconfigure this package go back to the panel and press Enter on this file.
  314.  
  315. EOInstall
  316.  
  317. $pressreinstall=<<EOInstall;
  318.  
  319.                                 WARNING
  320.   Don\'t use this method if you are not willing to reinstall this package...
  321.  
  322. This is not a real file. It is a way to reinstall the package you are browsing.
  323.  
  324. To reinstall this package go back to the panel and press Enter on this file.
  325.  
  326. EOInstall
  327.  
  328. $pressselect=<<EOInstall;
  329.  
  330.                                 WARNING
  331.   Don\'t use this method if you are not willing to select this package...
  332.  
  333. This is not a real file. It is a way to select the package you are browsing.
  334.  
  335. To select this package go back to the panel and press Enter on this file.
  336.  
  337. EOInstall
  338.  
  339. $pressunselect=<<EOInstall;
  340.  
  341.                                 WARNING
  342.   Don\'t use this method if you are not willing to unselect this package...
  343.  
  344. This is not a real file. It is a way to unselect the package you are browsing.
  345.  
  346. To unselect this package go back to the panel and press Enter on this file.
  347.  
  348. EOInstall
  349.  
  350. umask 077;
  351.  
  352. chop($name = `if [ -f "$ARGV[1]" ]; then cat $ARGV[1]; else echo $ARGV[1]; fi`);
  353. $name =~ s%.*/([0-9a-z.-]*)_.*%$1%;
  354.  
  355. exit 1 unless $name;
  356.  
  357. if($ARGV[0] eq "list") { &list($name); exit 0; }
  358. elsif($ARGV[0] eq "copyout") { ©out($name,$ARGV[2],$ARGV[3]); exit 0; }
  359. elsif($ARGV[0] eq "run") { &run($name,$ARGV[2]); exit 0; }
  360.  
  361. exit 1;
  362.  
  363.